#lang racket


;;https://gitee.com/wu-org/isa/blob/master/Tao4.rkt

(require srfi/13)
(require racket/list)


;; machine defination
(define CODE-SEG-BEGIN 0)
(define CODE-SEG-LEN 1024)
(define DATA-SEG-BEGIN 1024) ; 只要有把握，设成和CODE-SEG-BEGIN相同也可以的
(define DATA-SEG-LEN 256)
(define FRAME-BUFFER-BEGIN (+ DATA-SEG-BEGIN DATA-SEG-LEN))
(define FRAME-BUFFER-WIDTH  64)   ; 屏幕宽
(define FRAME-BUFFER-HEIGTH 64)   ; 屏幕高
(define MEM-LEN
  ;; (+ FRAME-BUFFER-BEGIN (* FRAME-BUFFER-WIDTH FRAME-BUFFER-HEIGTH))
  65536
  )
(define MEM (make-vector MEM-LEN 0))
(define COINS-REMAIN 4096) ; 每运行一个周期消耗一个币
(define PC           0)
(define REGSTACK '())
(define CYCLES   0)

(define ISA
  (list
   ;;     op             code  args  action
   ;; 0x00-0x0F: 特殊指令
   (list 'NOP            #x00  0 (lambda ()                                                                                (pc+! 1)))
   ;; 0x10-0x1F: 栈操作
   (list 'PUSH           #x10  1 (lambda () (push! (get-arg 1))                                                            (pc+! 2)))
   (list 'POP            #x11  0 (lambda () (pop!)                                                                         (pc+! 1)))
   (list 'DUP            #x12  0 (lambda () (push! (if (null? REGSTACK) (pop!) (car REGSTACK)))                            (pc+! 1)))
   (list 'SWAP           #x13  0 (lambda ()        (let ((a (pop!)) (b (pop!))) (push! a) (push! b))                       (pc+! 1)))
   (list 'OVER           #x14  0 (lambda () (push! (cadr REGSTACK))                                                        (pc+! 1)))
   ;; 0x20-0x2F: 算术运算
   (list 'ADD            #x20  0 (lambda () (push! (let* ((op2 (pop!)) (op1 (pop!))) (+ op1 op2)))                         (pc+! 1)))
   (list 'SUB            #x21  0 (lambda () (push! (let* ((op2 (pop!)) (op1 (pop!))) (- op1 op2)))                         (pc+! 1)))
   (list 'MUL            #x22  0 (lambda () (push! (let* ((op2 (pop!)) (op1 (pop!))) (* op1 op2)))                         (pc+! 1)))
   (list 'DIV            #x23  0 (lambda () (push! (let* ((op2 (pop!)) (op1 (pop!))) (if (= 0 op2) (random MEM-LEN) (/ op1 op2))))        (pc+! 1)))
   (list 'MOD            #x24  0 (lambda () (push! (let* ((op2 (pop!)) (op1 (pop!))) (if (= 0 op2) (random MEM-LEN) (remainder op1 op2))))(pc+! 1)))
   ;; 0x30-0x3F: 位运算
   (list 'AND            #x30  0 (lambda () (push! (let* ((op2 (pop!)) (op1 (pop!))) (bitwise-and op1 op2)))               (pc+! 1)))
   (list 'OR             #x31  0 (lambda () (push! (let* ((op2 (pop!)) (op1 (pop!))) (bitwise-ior op1 op2)))               (pc+! 1)))
   (list 'NOT            #x32  0 (lambda () (push! (let* ((op1 (pop!)))              (bitwise-not op1)))                   (pc+! 1)))
   ;; 0x40-0x4F: 比较运算
   (list 'EQ             #x40  0 (lambda () (push! (let* ((op2 (pop!)) (op1 (pop!))) (if      (= op1 op2)  1 0)))          (pc+! 1)))
   (list 'NEQ            #x41  0 (lambda () (push! (let* ((op2 (pop!)) (op1 (pop!))) (if (not (= op1 op2)) 1 0)))          (pc+! 1)))
   (list 'GT             #x42  0 (lambda () (push! (let* ((op2 (pop!)) (op1 (pop!))) (if     (>  op1 op2)  1 0)))          (pc+! 1)))
   (list 'GTE            #x43  0 (lambda () (push! (let* ((op2 (pop!)) (op1 (pop!))) (if     (>= op1 op2)  1 0)))          (pc+! 1)))
   (list 'LT             #x44  0 (lambda () (push! (let* ((op2 (pop!)) (op1 (pop!))) (if     (<  op1 op2)  1 0)))          (pc+! 1)))
   (list 'LTE            #x45  0 (lambda () (push! (let* ((op2 (pop!)) (op1 (pop!))) (if     (<= op1 op2)  1 0)))          (pc+! 1)))
   ;; 0x50-0x5F: 内存操作
   (list 'STORE          #x50  0 (lambda () (let* ((val (pop!)) (addr (pop!))) (set-data! addr val))                       (pc+! 1)))
   (list 'LOAD           #x51  0 (lambda () (let* ((addr (pop!))) (push! (get-data addr)))                                 (pc+! 1)))
   (list 'COPY           #x52  0 (lambda () (let* ((addr2 (pop!)) (addr1 (pop!))) (set-data! addr2 (get-data addr1)))      (pc+! 1)))
   ;; 0x60-0x6F: 控制流
   (list 'JUMP           #x60  1 (lambda ()                        (set-pc! (get-arg 1))))
   (list 'JUMPIF         #x61  1 (lambda () (if (not (= (pop!) 0)) (set-pc! (get-arg 1))                                   (pc+! 2))))
   (list 'JUMPIF-NOT     #x62  1 (lambda () (if      (= (pop!) 0)  (set-pc! (get-arg 1))                                   (pc+! 2))))
   (list 'JUMP-REL       #x63  1 (lambda ()													                           (pc+! (get-arg 1))))
   (list 'CALL           #x64  1 (lambda () (push! (+ PC 2))       (set-pc! (get-arg 1))))
   (list 'RET            #x65  0 (lambda ()                        (set-pc! (pop!))))
   ;; 0x70-0x7F: I/O操作
   (list 'PRINT          #x70  0 (lambda () (display (pop!)) (display #\newline)                                           (pc+! 1)))
   (list 'SET-UNICODE    #x71  0 (lambda () (let* ((op3 (pop!)) (op2 (pop!)) (op1 (pop!))) (set-unicode! op1 op2 op3)      (pc+! 1))))
   (list 'GET-UNICODE    #x72  0 (lambda () (let* ((op2 (pop!)) (op1 (pop!))) (get-unicode op1 op2)                        (pc+! 1))))
   ;; 0x80-0x8F: 系统功能
   (list 'RANDOM         #x73  0 (lambda () (push! (let* ((op1 (pop!)))              (random op1)))                        (pc+! 1)))
   (list 'TIME           #x74  0 (lambda () (push! (current-seconds))                                                      (pc+! 1)))
   ;; HALT 0xff
   (list 'HALT           #xff  0 (lambda ()                                                                                (pc+! 1)))
   ))

;; basic facility
(define (ragularized mod-n) (lambda (x) (modulo (inexact->exact (truncate x)) mod-n)))
(define (regularized-addr     x) ((ragularized             MEM-LEN) x))
(define (regularized-screen-x x) ((ragularized  FRAME-BUFFER-WIDTH) x))
(define (regularized-screen-y y) ((ragularized FRAME-BUFFER-HEIGTH) y))
(define (push! x)           (set! REGSTACK (cons x REGSTACK)))
(define (pop!)              (if (null? REGSTACK) (random MEM-LEN) (let ((result (car REGSTACK))) (set! REGSTACK (cdr REGSTACK)) result)))
(define (set-pc! n)         (set! PC n) PC)
(define (pc+!    n)         (set-pc! (+ PC n)))
(define (read-code addr)    (vector-ref MEM (+ addr CODE-SEG-BEGIN)))
(define (get-arg n)         (read-code (+ n PC)))
(define (get-data addr)     (vector-ref  MEM (regularized-addr (+ addr DATA-SEG-BEGIN))))
(define (set-data! addr val)(vector-set! MEM (regularized-addr (+ addr DATA-SEG-BEGIN)) val))
(define (get-instr)         (modulo (read-code PC) 256))
(define (set-unicode! x y code)     (vector-set! MEM (+ (* (regularized-screen-y y) FRAME-BUFFER-WIDTH)
                                                        (regularized-screen-x x)
                                                        FRAME-BUFFER-BEGIN)
                                                 (modulo code #x10000)))
(define (get-unicode x y)           (modulo
                                     (vector-ref  MEM (+ (* (regularized-screen-y y) FRAME-BUFFER-WIDTH)
                                                         (regularized-screen-x x)
                                                         FRAME-BUFFER-BEGIN))
                                     #x10000))
(define (render-frame-buffer)
  (define html-file "frame-buffer.html")
  (define (unicode-char->html unicode)
    (let ((uchar
           (if (<= #xD800 unicode #xDFFF)
               #\space
               (integer->char (modulo unicode 65536)))))
      (cond
        ((char-whitespace? uchar) "&nbsp;")
        ((char=? uchar #\<) "&lt;")
        ((char=? uchar #\>) "&gt;")
        ((char=? uchar #\&) "&amp;")
        (else (string uchar)))))
  (call-with-output-file html-file
    (lambda (out)
      (display "<!DOCTYPE html>
<html>
<head>
    <meta charset=\"UTF-8\">
    <title>Frame Buffer</title>
    <style>
        table {
            border-collapse: collapse;
            font-family: monospace;
            font-size: 16px;
            line-height: 1;
        }
        td {
            width: 20px;
            height: 20px;
            text-align: center;
            border: 1px solid #ccc;
            padding: 0;
        }
    </style>
</head>
<body>
    <table>" out)

      ; 生成表格行和列
      (for ([y (in-range FRAME-BUFFER-HEIGTH)])
        (display "<tr>" out)
        (for ([x (in-range FRAME-BUFFER-WIDTH)])
          (let* ((unicode (get-unicode x y))
                 (char-display (unicode-char->html unicode)))
            (display (format "<td>~a</td>"
                             char-display) out)))
        (display "</tr>" out))

      (display "</table></body></html>" out))
    #:exists 'replace)

  (displayln (format "HTML文件已生成: ~a" html-file)))



(define HALT-OPCODE (cadr (assoc 'HALT ISA)))
(define cdr-mapped-ISA (map cdr ISA))

(define (ASSEMBLE list-of-code)
  (define ALIAS_MAP '((P PUSH) (PP POP)
                    (+ ADD)(- SUB) (* MUL) (/ DIV) (% MOD)
                    (= EQ) (> GT) (< LT)
                    (& AND) (~ NOT)
                    (CP COPY)
                    (JMP JUMP)
                    (SETU SET-UNICODE)
                    (HLT HALT)
                    ))
  (define (label? val)
    (and (symbol? val)
         (let ((cur-str (symbol->string val)))
           (char=? #\: (string-ref cur-str (- (string-length cur-str) 1))))))

  (define (instruction? val)
    (assoc val ISA))

  (let* ((list-of-code (map
                        (lambda (v)
                          (if (symbol? v)
                              (string->symbol (string-upcase (symbol->string v)))
                              v))
                        list-of-code))
         (labels
          (let loop ((i 0)
                     (L list-of-code)
                     (result '()))
            (cond ((null? L)
                   result)
                  ((label? (car L))
                   (let* ((cur (car L))
                          (cur-str (symbol->string (car L)))
                          (cur-str-no-colon (string-drop-right cur-str 1)))
                     (loop i (cdr L) (cons `(,(string->symbol cur-str-no-colon) ,i) result))))
                  (else
                   (loop (+ i 1) (cdr L) result))))))
    (let loop ((L list-of-code)
               (reversed-result '()))
      (if (null? L)
          (list->vector (reverse reversed-result))
          (let ((cur-val (car L)))
            (cond
              ((number? cur-val)
               (loop (cdr L) (cons cur-val reversed-result)))
              ((instruction? cur-val)
               (let* ((instr-item (assoc cur-val ISA))
                      (instr-name (car instr-item))
                      (instr-code (cadr instr-item))
                      (arg-num    (caddr instr-item)))
                 (if (= 0 arg-num)
                     (loop (cdr L) (cons instr-code reversed-result))
                     (loop (cddr L)
                           (cons (if (number? (cadr L))
                                     (cadr L)
                                     (let ((label-item  (assoc (cadr L) labels)))
                                       (if label-item
                                        (cadr label-item)
                                        (error `(error: unkown label ,(cadr L) in instr (,(car L) ,(cadr L)))))))
                                 (cons (cadr (assoc cur-val ISA)) reversed-result))))))
              ((assoc cur-val ALIAS_MAP)
               (let ((cur-instr-name (cadr (assoc cur-val ALIAS_MAP))))
                 (loop (cons cur-instr-name (cdr L)) reversed-result)))
              ((label? cur-val)
               (loop (cdr L) reversed-result))
              ((assoc cur-val labels) ; taget?
               (loop (cdr L) (cons (cadr (assoc cur-val labels)) reversed-result)))
              (else ; unkown symbol
               (error `(error: unkown symbol: ,cur-val)))))))))

(define LOADER
  (lambda (BYTE-CODE)
    (vector-copy! MEM CODE-SEG-BEGIN BYTE-CODE)))


(define (debug-print)
  (define dasm-list
    (map
     (lambda (item)
       `(,(cadr item) ,(car item)))
     ISA))

  (let* ((instr (get-instr))
         (item  (assoc instr cdr-mapped-ISA)))
    (display (format "~a\n"
                     `(CYCLES: ,CYCLES PC: ,PC REGSTACK: ,REGSTACK
                               instr:  ,(if (assoc instr dasm-list)
                                            `(,(cadr (assoc instr dasm-list))
                                              ,@(build-list
                                                 (cadr item)
                                                 (lambda (i) (get-arg (+ i 1)))))
                                            `(UNKNOW OPCODE: (,(read-code PC)))
                                         ))))))


(define (step-machine!)
  (let* ((instr (get-instr))
         (item  (assoc instr cdr-mapped-ISA)))
    (debug-print)
    (cond (item ; 有这指令
           ((caddr item)))
          (else ; 没这指令
           (pc+! 1))))

  (set! COINS-REMAIN (- COINS-REMAIN 1))
  )


(define (RUN-MACHINE)
  (let loop ()
    (cond ((<= COINS-REMAIN 0) ; 没coin了
           (displayln 'NOT-ENOUGH-COINS)
           PC)
          ((>= PC MEM-LEN)
           (begin
             (set-pc! 0)
             (loop)))
          ((eq? (get-instr) HALT-OPCODE)
           (step-machine!)
           (set! CYCLES (+ 1 CYCLES))
           PC)
          (else
           (step-machine!)
           (set! CYCLES (+ 1 CYCLES))
           (loop)))))


(define dump-file-name "coredump.scm")
(define (load-machine)
  (when (file-exists? dump-file-name)
    (let ((context (with-input-from-file dump-file-name read)))
      (set! PC (cadr (assoc 'PC context)))
      (set! REGSTACK (cadr (assoc 'REGSTACK context)))
      (set! MEM (cadr (assoc 'MEM context)))
      (set! CYCLES (cadr (assoc 'CYCLES context)))
      )))


(define (dump-machine)
  (with-output-to-file dump-file-name
    (lambda ()
      (write
       `((PC             ,PC      )
         (REGSTACK       ,REGSTACK)
         (CYCLES         ,CYCLES  )
         (MEM            ,MEM     ))))
    #:exists 'replace))

(define (make-test-code)
  `(
    ;; 清空画布 - 用循环清空整个屏幕
    PUSH 0           ; 初始y=0
    clear_y_loop:
    PUSH 0           ; 初始x=0
    clear_x_loop:
    
    ;; 设置当前坐标的字符为空格(32) - 参数顺序: x, y, char
    DUP              ; 复制x
    SWAP             ; 交换x和y，现在栈顶是y
    OVER             ; 复制x，现在栈顶是x
    PUSH 32          ; 空格字符
    SETU             ; 设置字符
    
    ;; x加1
    PUSH 1
    ADD
    
    ;; 检查x是否小于64
    DUP
    PUSH 64
    LT
    JUMPIF clear_x_loop  ; 如果x<64，继续内层循环
    
    ;; x循环结束，y加1
    POP              ; 弹出x
    SWAP             ; 交换，让y在栈顶
    PUSH 1
    ADD
    DUP              ; 复制y
    PUSH 64
    LT
    JUMPIF clear_y_loop  ; 如果y<64，继续外层循环
    
    POP              ; 弹出y
    
    ;; 三体自动化技术协会logo设计
    
    ;; 中心三体系统 - 更加复杂的轨道设计
    PUSH 32 PUSH 18 PUSH #x25CF SETU  ; 中心天体
    PUSH 24 PUSH 22 PUSH #x25CF SETU  ; 左天体
    PUSH 40 PUSH 22 PUSH #x25CF SETU  ; 右天体
    
    ;; 复杂轨道系统 - 三体混沌轨迹
    PUSH 28 PUSH 16 PUSH #x25E6 SETU  ; 轨道点1
    PUSH 26 PUSH 18 PUSH #x25E6 SETU  ; 轨道点2
    PUSH 28 PUSH 20 PUSH #x25E6 SETU  ; 轨道点3
    PUSH 32 PUSH 21 PUSH #x25E6 SETU  ; 轨道点4
    PUSH 36 PUSH 20 PUSH #x25E6 SETU  ; 轨道点5
    PUSH 38 PUSH 18 PUSH #x25E6 SETU  ; 轨道点6
    PUSH 36 PUSH 16 PUSH #x25E6 SETU  ; 轨道点7
    PUSH 32 PUSH 15 PUSH #x25E6 SETU  ; 轨道点8
    
    ;; 自动化技术齿轮系统 - 双层齿轮设计
    ;; 外层大齿轮
    PUSH 32 PUSH 10 PUSH #x25CB SETU  ; 齿轮中心
    PUSH 32 PUSH 8 PUSH #x2588 SETU   ; 上齿
    PUSH 29 PUSH 9 PUSH #x2588 SETU   ; 左上齿
    PUSH 35 PUSH 9 PUSH #x2588 SETU   ; 右上齿
    PUSH 27 PUSH 11 PUSH #x2588 SETU  ; 左齿
    PUSH 37 PUSH 11 PUSH #x2588 SETU  ; 右齿
    PUSH 29 PUSH 13 PUSH #x2588 SETU  ; 左下齿
    PUSH 35 PUSH 13 PUSH #x2588 SETU  ; 右下齿
    PUSH 32 PUSH 14 PUSH #x2588 SETU  ; 下齿
    
    ;; 内层小齿轮
    PUSH 32 PUSH 10 PUSH #x25CF SETU  ; 内齿轮中心
    PUSH 32 PUSH 9 PUSH #x2591 SETU   ; 内齿轮上齿
    PUSH 31 PUSH 10 PUSH #x2591 SETU  ; 内齿轮左齿
    PUSH 33 PUSH 10 PUSH #x2591 SETU  ; 内齿轮右齿
    PUSH 32 PUSH 11 PUSH #x2591 SETU  ; 内齿轮下齿
    
    ;; 技术电路连接 - 专业的技术连接
    PUSH 30 PUSH 12 PUSH #x2571 SETU  ; 左上电路连接
    PUSH 28 PUSH 14 PUSH #x2571 SETU  ; 连接线
    PUSH 26 PUSH 16 PUSH #x2571 SETU  ; 连接线
    PUSH 24 PUSH 18 PUSH #x2571 SETU  ; 连接线
    
    PUSH 34 PUSH 12 PUSH #x2572 SETU  ; 右上电路连接
    PUSH 36 PUSH 14 PUSH #x2572 SETU  ; 连接线
    PUSH 38 PUSH 16 PUSH #x2572 SETU  ; 连接线
    PUSH 40 PUSH 18 PUSH #x2572 SETU  ; 连接线
    
    ;; 技术处理核心 - 多层处理单元
    PUSH 32 PUSH 24 PUSH #x25A0 SETU  ; 主处理器
    PUSH 30 PUSH 23 PUSH #x2588 SETU  ; 处理器左扩展
    PUSH 34 PUSH 23 PUSH #x2588 SETU  ; 处理器右扩展
    PUSH 32 PUSH 25 PUSH #x2588 SETU  ; 处理器下扩展
    
    ;; 数据流网络 - 技术协会的数据交换
    PUSH 22 PUSH 26 PUSH #x2192 SETU  ; 左输入箭头
    PUSH 24 PUSH 26 PUSH #x2192 SETU  ; 输入流
    PUSH 26 PUSH 26 PUSH #x2192 SETU  ; 输入流
    PUSH 28 PUSH 26 PUSH #x2192 SETU  ; 输入流
    
    PUSH 36 PUSH 26 PUSH #x2190 SETU  ; 右输入箭头
    PUSH 38 PUSH 26 PUSH #x2190 SETU  ; 输入流
    PUSH 40 PUSH 26 PUSH #x2190 SETU  ; 输入流
    PUSH 42 PUSH 26 PUSH #x2190 SETU  ; 输入流
    
    PUSH 32 PUSH 28 PUSH #x2193 SETU  ; 下输出箭头
    PUSH 32 PUSH 30 PUSH #x2193 SETU  ; 输出流
    PUSH 32 PUSH 32 PUSH #x2193 SETU  ; 输出流
    
    ;; 技术代码背景 - 专业的技术符号
    PUSH 18 PUSH 34 PUSH #x03A3 SETU  ; Sigma符号(求和)
    PUSH 20 PUSH 34 PUSH #x03A9 SETU  ; Omega符号
    PUSH 22 PUSH 34 PUSH #x2200 SETU  ; 全称量词
    PUSH 24 PUSH 34 PUSH #x2203 SETU  ; 存在量词
    
    PUSH 40 PUSH 34 PUSH #x2211 SETU  ; 求和符号
    PUSH 42 PUSH 34 PUSH #x222B SETU  ; 积分符号
    PUSH 44 PUSH 34 PUSH #x2202 SETU  ; 偏微分符号
    PUSH 46 PUSH 34 PUSH #x2207 SETU  ; 梯度符号
    
    ;; 二进制技术流 - 专业的技术数据
    PUSH 18 PUSH 36 PUSH #x30 SETU    ; 0
    PUSH 19 PUSH 36 PUSH #x31 SETU    ; 1
    PUSH 20 PUSH 36 PUSH #x30 SETU    ; 0
    PUSH 21 PUSH 36 PUSH #x31 SETU    ; 1
    PUSH 22 PUSH 36 PUSH #x31 SETU    ; 1
    PUSH 23 PUSH 36 PUSH #x30 SETU    ; 0
    
    PUSH 41 PUSH 36 PUSH #x31 SETU    ; 1
    PUSH 42 PUSH 36 PUSH #x30 SETU    ; 0
    PUSH 43 PUSH 36 PUSH #x31 SETU    ; 1
    PUSH 44 PUSH 36 PUSH #x30 SETU    ; 0
    PUSH 45 PUSH 36 PUSH #x31 SETU    ; 1
    PUSH 46 PUSH 36 PUSH #x31 SETU    ; 1
    
    ;; 协会全称 - 三体自动化技术协会
    PUSH 20 PUSH 40 PUSH #x4E09 SETU  ; 三 (正确的Unicode编码)
    PUSH 22 PUSH 40 PUSH #x4F53 SETU  ; 体
    PUSH 24 PUSH 40 PUSH #x81EA SETU  ; 自
    PUSH 26 PUSH 40 PUSH #x52A8 SETU  ; 动
    PUSH 28 PUSH 40 PUSH #x5316 SETU  ; 化
    PUSH 30 PUSH 40 PUSH #x6280 SETU  ; 技
    PUSH 32 PUSH 40 PUSH #x672F SETU  ; 术
    PUSH 34 PUSH 40 PUSH #x534F SETU  ; 协
    PUSH 36 PUSH 40 PUSH #x4F1A SETU  ; 会
    
    ;; 英文缩写 - TATA (Three-body Automation Technology Association)
    PUSH 26 PUSH 42 PUSH #x54 SETU    ; T
    PUSH 28 PUSH 42 PUSH #x41 SETU    ; A
    PUSH 30 PUSH 42 PUSH #x54 SETU    ; T
    PUSH 32 PUSH 42 PUSH #x41 SETU    ; A
    
    ;; 技术年份标识
    PUSH 38 PUSH 42 PUSH #x32 SETU    ; 2
    PUSH 39 PUSH 42 PUSH #x30 SETU    ; 0
    PUSH 40 PUSH 42 PUSH #x32 SETU    ; 2
    PUSH 41 PUSH 42 PUSH #x34 SETU    ; 4
    
    ;; 专业边框设计 - 使用循环绘制边框
    
    ;; 绘制四个角
    PUSH 16 PUSH 6 PUSH #x2554 SETU   ; 双线左上角
    PUSH 48 PUSH 6 PUSH #x2557 SETU   ; 双线右上角
    PUSH 16 PUSH 44 PUSH #x255A SETU  ; 双线左下角
    PUSH 48 PUSH 44 PUSH #x255D SETU  ; 双线右下角
    
    ;; 使用循环绘制上边框 (x从17到47, y=6)
    PUSH 17           ; 初始x=17
    top_border_loop:
    DUP              ; 复制x
    PUSH 6           ; y=6
    PUSH #x2550      ; 水平边框字符
    SETU             ; 设置字符
    
    PUSH 1           ; x加1
    ADD
    DUP              ; 复制x
    PUSH 48          ; 检查x是否小于48
    LT
    JUMPIF top_border_loop  ; 如果x<48，继续循环
    
    POP              ; 弹出x
    
    ;; 使用循环绘制下边框 (x从17到47, y=44)
    PUSH 17           ; 初始x=17
    bottom_border_loop:
    DUP              ; 复制x
    PUSH 44          ; y=44
    PUSH #x2550      ; 水平边框字符
    SETU             ; 设置字符
    
    PUSH 1           ; x加1
    ADD
    DUP              ; 复制x
    PUSH 48          ; 检查x是否小于48
    LT
    JUMPIF bottom_border_loop  ; 如果x<48，继续循环
    
    POP              ; 弹出x
    
    ;; 使用循环绘制左边框 (y从7到43, x=16)
    PUSH 7            ; 初始y=7
    left_border_loop:
    DUP              ; 复制y
    PUSH 16          ; x=16
    SWAP             ; 交换x和y
    PUSH #x2551      ; 垂直边框字符
    SETU             ; 设置字符
    
    PUSH 1           ; y加1
    ADD
    DUP              ; 复制y
    PUSH 44          ; 检查y是否小于44
    LT
    JUMPIF left_border_loop  ; 如果y<44，继续循环
    
    POP              ; 弹出y
    
    ;; 使用循环绘制右边框 (y从7到43, x=48)
    PUSH 7            ; 初始y=7
    right_border_loop:
    DUP              ; 复制y
    PUSH 48          ; x=48
    SWAP             ; 交换x和y
    PUSH #x2551      ; 垂直边框字符
    SETU             ; 设置字符
    
    PUSH 1           ; y加1
    ADD
    DUP              ; 复制y
    PUSH 44          ; 检查y是否小于44
    LT
    JUMPIF right_border_loop  ; 如果y<44，继续循环
    
    POP              ; 弹出y
    
    HLT
    ))

(load-machine)
(define bytecode (ASSEMBLE (make-test-code)))
(LOADER bytecode)
(RUN-MACHINE)
(dump-machine)
(render-frame-buffer)
